home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue72 / dynimag / Listing4.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2001-07-03  |  4.4 KB  |  152 lines
  1. program DrBob;
  2. {$APPTYPE CONSOLE}
  3. uses
  4.   DrBobCGI, Classes, SysUtils, DB, DBClient;
  5.   procedure DataSet2HTML(const DataSet: TDataSet);
  6.   var
  7.     fields: Integer;
  8.     RecNo: Integer;
  9.   begin
  10.     writeln('<table border=1>');
  11.     DataSet.Open;
  12.     write('<tr>');
  13.     for fields:=0 to Pred(DataSet.FieldCount) do
  14.       write('<td bgcolor=ffffff><b>',DataSet.Fields[fields].FieldName,'</td>');
  15.     writeln('</tr>');
  16.     DataSet.First;
  17.     RecNo := 0;
  18.     while not DataSet.Eof do
  19.     begin
  20.       Inc(RecNo);
  21.       write('<tr>');
  22.       for fields:=0 to Pred(DataSet.FieldCount) do
  23.         if DataSet.Fields[fields] IS TGraphicField then { GRAPHICS }
  24.           writeln('<td><img src="',ScriptName,'?IMG=yes&RecNo=',RecNo,
  25.             '&FieldName=',DataSet.Fields[fields].FieldName,'"></td>')
  26.         else
  27.           write('<td>',DataSet.Fields[fields].AsString,'</td>');
  28.       writeln('</tr>');
  29.       DataSet.Next
  30.     end;
  31.     writeln('</table>')
  32.   end {DataSet2HTML};
  33.   procedure Record2HTML(const DataSet: TDataSet; RecNo: Integer);
  34.   var
  35.     fields: Integer;
  36.   begin
  37.     for fields:=0 to Pred(DataSet.FieldCount) do
  38.       if DataSet.Fields[fields] IS TGraphicField then { GRAPHICS }
  39.         writeln('<b>',DataSet.Fields[fields].FieldName,':</b> ',
  40.           '<img src="',ScriptName,'?IMG=yes&RecNo=',RecNo,'&FieldName=',
  41.             DataSet.Fields[fields].FieldName,'"><br>')
  42.       else
  43.         writeln('<b>',DataSet.Fields[fields].FieldName,':</b> ',
  44.           DataSet.Fields[fields].AsString,'<br>')
  45.   end {Record2HTML};
  46.   procedure NavigatorHTML(const DataSet: TDataSet; RecNo: Integer);
  47.   begin
  48.     if RecNo = 0 then RecNo := 1;
  49.     if not DataSet.Active then DataSet.Open;
  50.     write('<a href="',ScriptName,'?RecNo=1">First</a> | ');
  51.     write('<a href="',ScriptName,'?RecNo=',Pred(RecNo),'">Prior</a> | ');
  52.     write('<a href="',ScriptName,'?RecNo=',Succ(RecNo),'">Next</a> | ');
  53.     write('<a href="',ScriptName,'?RecNo=-1">Last</a> | ');
  54.     write('<a href="',ScriptName,'?RecNo=',RecNo,'">Refresh</a> ',
  55.           '(',RecNo,')<br>')
  56.   end {NavigatorHTML};
  57.   procedure DataSetRecNo(DataSet: TDataSet; var RecNo: Integer);
  58.   var
  59.     i: Integer;
  60.   begin
  61.     DataSet.Open;
  62.     if RecNo = -1 then
  63.     begin
  64.       RecNo := 1;
  65.       while not DataSet.Eof do
  66.       begin
  67.         Inc(RecNo);
  68.         DataSet.Next
  69.       end
  70.     end
  71.     else
  72.       for i:=1 to Pred(RecNo) do DataSet.Next;
  73.     if DataSet.Eof then // went past Eof, need to backtrack!
  74.     begin
  75.       Dec(RecNo); // one before Eof
  76.       DataSet.First;
  77.       for i:=1 to Pred(RecNo) do DataSet.Next
  78.     end
  79.   end {DataSetRecNo};
  80.   procedure Table2HTML(const TableName: String; RecNo: Integer);
  81.   var
  82.     DataSet: TClientDataSet;
  83.   begin
  84.     DataSet := TClientDataSet.Create(nil);
  85.     try
  86.       DataSet.FileName := TableName;
  87.       DataSet.Open;
  88.       DataSetRecNo(DataSet, RecNo);
  89.       NavigatorHTML(DataSet,RecNo);
  90.       writeln('<hr>');
  91.       Record2HTML(DataSet,RecNo);
  92.       writeln('<hr>');
  93.       NavigatorHTML(DataSet,RecNo);
  94.       writeln('<hr>');
  95.       DataSet2HTML(DataSet);
  96.     finally
  97.       DataSet.Close;
  98.       DataSet.Free;
  99.     end
  100.   end {Table2HTML};
  101.   procedure Table2Img(const TableName, FieldName: String; RecNo: Integer);
  102.   var
  103.     DataSet: TClientDataSet;
  104.     Str: String;
  105.     i: Integer;
  106.   begin
  107.     DataSet := TClientDataSet.Create(nil);
  108.     try
  109.       DataSet.FileName := TableName;
  110.       DataSetRecNo(DataSet, RecNo);
  111.       Str := (DataSet.FieldByName(FieldName) AS TGraphicField).AsString;
  112.       for i:=9 to Length(Str) do write(Str[i]);
  113.     finally
  114.       DataSet.Close;
  115.       DataSet.Free;
  116.     end
  117.   end {Table2Img};
  118. const
  119.   Biolife = 'biolife.cds';
  120. var
  121.   RecNo: Integer;  
  122.   Dir: String;
  123. begin
  124.   RecNo := StrToIntDef(Value('RecNo'),1);
  125.   if Value('IMG') = 'yes' then
  126.   begin
  127.     writeln('content-type: image/bmp');
  128.     writeln;
  129.     Table2Img(Biolife,Value('FieldName'), RecNo)
  130.   end
  131.   else
  132.   try
  133.     writeln('content-type: text/html');
  134.     writeln;
  135.     writeln('<html>');
  136.     writeln('<body bgcolor=ffffcc>');
  137.     writeln(ScriptName,' = ',ParamStr(0),'<br>');
  138.     GetDir(0,Dir);
  139.     writeln('Working Directory: ',Dir,'<br>');
  140.     writeln(RemoteAddress,'<hr>');
  141.     try
  142.       Table2HTML(Biolife, RecNo);
  143.     except
  144.       on E: Exception do
  145.         writeln(E.ClassName,': ',E.Message)
  146.     end
  147.   finally
  148.     writeln('</body>');
  149.     writeln('</html>')
  150.   end
  151. end.
  152.